home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 2 of 2).iso / 1000-spectrum / zxam spectrum / zxam_rexx / english / listbasic.zxam < prev    next >
Encoding:
Text File  |  1994-10-22  |  2.0 KB  |  88 lines
  1. /* this script saves the ASCII listing of the BASIC program inside the */ 
  2. /* Spectrum's memory */
  3.     
  4.     /* test if emulator is present */
  5.     address command
  6.     
  7.     if ~show(ports,ZXAM_REXX) then do
  8.         requestchoice '>nil: title "ZXAM Script error..." body "I can''t find the emulator''s port!!" gadgets "AARGH!"'
  9.         exit
  10.         end
  11.  
  12.     /* locate the BASIC listing */
  13.     
  14.     /* start of BASIC */
  15.     baselist=zxamdpeek(23635)
  16.     
  17.     /* end of BASIC */
  18.     endlist=zxamdpeek(23627)
  19.     
  20.     /* length of BASIC */
  21.     longbasic=endlist-baselist
  22.     if longbasic=0 then do
  23.         requestchoice '>nil: title "ZXAM Script error..." body "No BASIC program in memory!!" gadgets "AARGH!"'
  24.         exit 0
  25.         end
  26.     
  27.     /* get all the BASIC block */
  28.     bloquebasic=zxamgetmem(baselist,endlist-baselist)
  29.     
  30.     
  31.     /* ask for path&name */
  32.     oldpath=zxamactsavepath()
  33.     oldpattern=zxamactpattern()
  34.     zxampattern('#?')
  35.     nombre=zxamsaverequester('Name for BASIC listing...','ram:')
  36.     zxamsavepath(oldpath)
  37.     zxampattern(oldpattern)
  38.     if nombre='' then exit 0    /* CANCEL */
  39.     
  40.     if ~open('fichero',nombre,'w') then exit 0
  41.     
  42.     /* old window status */
  43.     oldname=zxamactname()
  44.     oldformat=zxamactformat()
  45.     
  46.     ZXAMEnableAbort()        /* enables 'Abort ARexx' gadget */
  47.     
  48.     do forever
  49.     
  50.     /* process a line */
  51.         
  52.         /* print line number */
  53.         numlinea=c2d(left(bloquebasic,2))
  54.         dummy=writech('fichero','  'numlinea)
  55.         zxamnameformat('     Converting line 'numlinea,'Wait...')
  56.         longline=c2d(reverse(substr(bloquebasic,3,2))) /* reversed Z80 format */
  57.         do i=5 to 4+longline    /* to process the line chars */
  58.         if substr(bloquebasic,i,1)='0e'x then do
  59.             i=i+5
  60.             iterate
  61.             end
  62.         dummy=writech('fichero',zxambasictoken(substr(bloquebasic,i,1)))
  63.         
  64.         if zxamreadabort() then do
  65.             if oldname='' then
  66.                 zxamclearnameformat()
  67.             else
  68.                 zxamnameformat(oldname,oldformat)
  69.             exit
  70.             end
  71.         
  72.         end i
  73.         
  74.     dummy=writech('fichero','0a'x)
  75.     
  76.     bloquebasic=right(bloquebasic,length(bloquebasic)-(longline+4))
  77.     if bloquebasic='' then break
  78.     end
  79.     
  80.     dummy=close('fichero')
  81.     
  82.     if oldname='' then
  83.         zxamclearnameformat()
  84.     else
  85.         zxamnameformat(oldname,oldformat)
  86.     
  87.     exit
  88.